home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / mouse.exe / GMTEST.PAS next >
Pascal/Delphi Source File  |  1989-06-03  |  5KB  |  151 lines
  1. { a program to test a graphics based mouse }
  2. program GmTest;
  3. uses crt,Graph,Mouse;
  4.  
  5. type string80 = string[80];
  6. var gm,gd,i:integer;
  7.     R,X,Y:integer;
  8.     MaxLen : integer;
  9.     Done:boolean;
  10.     OmouseX,OmouseY:integer;
  11.     OldClk : word;
  12.     SysClk : word absolute $40:$6C;
  13.     ch : char;
  14.     S : string[80];
  15.  
  16. const
  17.    KeyHome = #199;
  18.    KeyEnd  = #207;
  19.    KeyPgUp = #201;
  20.    KeyPgDo = #209;
  21.    KeyArUp = #200;
  22.    KeyArDo = #208;
  23.    KeyArLft = #203;
  24.    KeyArRgt  = #205;
  25.    KeyL = 'L';
  26.    KeyR = 'R';
  27.    KeyRet = #13;
  28.  
  29. {convert an integer to a string}
  30. function fstr(I:integer):string80;
  31. var temp:string80;
  32. begin
  33.   str(i,temp);
  34.   fstr := temp;
  35. end;
  36.  
  37. {show the current mouse status}
  38. procedure ShowPosition;
  39. begin
  40.    HideMouse;
  41. {   HideMouseArea(PutMx(0),PutMy((GetMaxY-10)-16), }  {alternate hide for}
  42. {                 PutMx(GetMaxX),PutMy(GetMaxY));  }  {non-EGA screens}
  43.  
  44.    S := 'X:'+fstr(GetMx(MouseX))+
  45.        ' Y:'+fstr(GetMy(MouseY))+
  46.        ' CrtMode:'+fstr(CrtMode)+
  47.        ' MouseType:'+fstr(MouseType);
  48.    if ((length(S)+5)*TextWidth('X')) > MaxLen then
  49.    begin
  50.      MaxLen := (length(S)+5)*TextWidth('X');
  51.      Rectangle(0,GetMaxY-(TextHeight('X')+4),MaxLen,GetMaxY);
  52.    end;
  53.    SetFillStyle(SolidFill,black);
  54.    Bar(1,GetMaxY-(TextHeight('X')+4)+1,MaxLen-1,GetMaxY-1);
  55.    SetColor(MouseColor);
  56.    OutTextXY(4,GetMaxY-9,S);
  57.    ShowMouse;
  58. end;
  59.  
  60. begin
  61.    Done := false;
  62.    gd := 0;        {<- you can force a display type here}
  63.    gm := 0;
  64.    InitGraph(gd,gm,'');      {init the graphics display}
  65.    if gd = HercMono then     {if Herc display, set Herc mouse page to 0}
  66.      SetHercMouse(0);
  67.    SetColor(GetMaxColor);
  68.    MaxLen := 1;
  69.    for i := 1 to 50 do        {put some circles on the screen}
  70.    begin                                {to make it look busy}
  71.      R := random(40)+10;
  72.      X := random(GetMaxX);
  73.      Y := random(GetMaxY);
  74.      Circle(X,Y,R);
  75.    end;
  76.  
  77. {   UseMouseSim := true; }   {<-- uncomment this to use mouse emulation}
  78.  
  79.    MouseColor := white;
  80.    InitMouse;
  81.  
  82. {   MouseInstalled := false;}  {<-- uncomment to disable existing mouse}
  83.  
  84. {   MouseClock(true);   }  {<-- uncomment to hook mouse to clock ISR }
  85.  
  86.    SetMouseArea(PutMx(0),PutMy(0),PutMx(GetMaxX),PutMy(GetMaxY));
  87.    SetMousePosition(PutMx(GetMaxX shr 1),PutMy(GetMaxY shr 1));
  88.    ShowMouse;
  89.    while not(Done) do
  90.    begin                    {we can also use the keyboard to move the mouse}
  91.      if KeyPressed then
  92.      begin
  93.        ch := upcase(ReadKey);
  94.        if ch = #0 then
  95.          ch := char(ord(ReadKey) or $80);
  96.        case ch of
  97.          KeyHome : begin SetMousePosition(PutMx(0),MouseY); end;
  98.          KeyEnd  : begin SetMousePosition(PutMx(GetMaxX),MouseY); end;
  99.          KeyPgUp : begin SetMousePosition(MouseX,PutMy(0)); end;
  100.          KeyPgDo : begin SetMousePosition(MouseX,PutMy(GetMaxY)); end;
  101.          KeyArUp : begin SetMousePosition(MouseX,PutMy(GetMy(MouseY)-1)); end;
  102.          KeyArDo : begin SetMousePosition(MouseX,PutMy(GetMy(MouseY)+1)); end;
  103.          KeyArLft : begin SetMousePosition(PutMx(GetMx(MouseX)-1),MouseY); end;
  104.          KeyArRgt : begin SetMousePosition(PutMx(GetMx(MouseX)+1),MouseY); end;
  105.          KeyL : begin MouseClicked := true; MouseClickButton := 1; end;
  106.          KeyR : begin MouseClicked := true; MouseClickButton := 2; end;
  107.          KeyRet : begin end;
  108.        else
  109.          if ch < #33 then Done := true;
  110.        end;
  111.      end;
  112.  
  113.      if not(MouseHooked) then ReadMouse;  {if polled mode, poll the mouse}
  114.      if MouseClick then                      {was a mouse button clicked?}
  115.      begin
  116.        if MouseClickButton = MouseLeftButton then    {left button clicked}
  117.        begin                                           {so do a floodfill}
  118.          HideMouse;                                 {at the current mouse}
  119.          SetFillStyle(solidfill,MouseColor);             {cursor position}
  120.          FloodFill(GetMx(MouseX),GetMy(MouseY),GetMaxColor);
  121.          ShowPosition;
  122.          ShowMouse;
  123.        end;
  124.        if MouseClickButton = MouseRightButton then    {right button pressed}
  125.        begin                                         {so change mouse shape}
  126.          inc(MouseColor);                                {and working color}
  127.          if MouseColor > GetMaxColor then MouseColor := 1;
  128.          ShowPosition;
  129.          inc(MouseGShape);
  130.          if MouseGShape > MaxMouseGraphShape then MouseGShape := 1;
  131.          MouseGraphicCursor(MouseGShape);
  132.          MouseReDraw := true;
  133.          ShowMouse;
  134.        end;
  135.      end;
  136.  
  137.      {if nothing else is happening, periodically update the mouse status}
  138.      if (OldClk <> SysClk) and
  139.         ((MouseX <> OMouseX) or (MouseY <> OMouseY)) then
  140.      begin
  141.        OMouseX := MouseX;
  142.        OMouseY := MouseY;
  143.        OldClk := SysClk;
  144.        ShowPosition;
  145.      end;
  146.    end;
  147.    HideMouse;               {hide the mouse before we exit}
  148.    CloseGraph;              {then turn off the graphics mode}
  149. end.
  150.  
  151.